home *** CD-ROM | disk | FTP | other *** search
- {
- The TVector component for Delphi was designed and implemented by:
-
- Berend Tober
- 22 Robin Hill Road
- Waterford, CT 06385
-
- Compuserve: 70541,1030
-
- Internet:
- btober@compuserve.com
- btober@connix.com
-
-
- The Vector Unit for Borland Delphi exports the TVector component
- which is used to model vectors, i.e., the members of an
- N-dimensional, real vector space.
- }
-
- unit Vector;
-
- interface
-
- uses SysUtils, Classes;
-
- type
- EUnequalVectorLength = class(Exception);
-
- TVector = class(TList)
- private
- { Private declarations }
- function GetElement(i: Word): Real;
- function GetMagnitude: Real;
- function GetMagSquared: Real;
- procedure SetElement(x: Real; i: Word);
- protected
- { Protected declarations }
- public
- { Public declarations }
- property Element[Index: Word]: Real Read GetElement;
- property Magnitude: Real Read GetMagnitude;
- property MagSquared: Real Read GetMagSquared;
- function Add(x: Real): Integer;
- procedure Scale(a:Real);
- procedure Normalize;
- function Clone: TVector;
- procedure Sum(a: Real; v: TVector);
- function Dot(v: TVector): Real;
- procedure Destroy;
- end;
-
- implementation
-
- function TVector.GetElement(i: Word): Real;
- var
- ptrX: ^Real;
- begin
- i := i-1;
- ptrX := Items[i];
- Result := ptrX^;
- end;
-
- procedure TVector.SetElement(x: Real; i: Word);
- var
- ptrX: ^Real;
- begin
- i := i-1;
- ptrX := Items[i];
- ptrX^ := x
- end;
-
- function TVector.Add(x: Real): Integer;
- var
- ptrX: ^Real;
- begin
- new(ptrX);
- ptrX^ := x;
- Result := 1+inherited Add(ptrX);
- end;
-
- procedure TVector.Destroy;
- var
- i: Word;
- ptrX: ^Real;
- begin
- If Count > 0 then for i := 0 to (Count-1) do
- begin
- ptrX := Items[i];
- Dispose(ptrX);
- end;
- inherited Destroy;
- end;
-
- function TVector.GetMagSquared: Real;
- var
- i: Word;
- x: Real;
- s: Double;
- begin
- s := 0.0;
- for i := 1 to Count do
- begin
- x := GetElement(i);
- s := s+x*x;
- end;
- Result := s;
- end;
-
- function TVector.GetMagnitude: Real;
- begin
- Result := sqrt(GetMagSquared);
- end;
-
- procedure TVector.Scale(a:Real);
- var
- i: Word;
- begin
- for i := 1 to Count do SetElement(a*GetElement(i),i);
- end;
-
- procedure TVector.Normalize;
- var
- d: Real;
- begin
- d := GetMagnitude;
- Scale(1./d);
- end;
-
- function TVector.Clone: TVector;
- var
- i: Word;
- v: TVector;
- begin
- v := TVector.Create;
- for i := 1 to Count do v.Add(GetElement(i));
- Result := v;
- end;
-
- procedure TVector.Sum(a: Real; v: TVector);
- var
- i: Word;
- u: TVector;
- begin
- if Count <> v.Count then raise EUnequalVectorLength.Create('Vectors of unequal length in sum');
- u := v.Clone;
- u.Scale(a);
- for i := 1 to Count do SetElement(GetElement(i)+u.GetElement(i),i);
- u.Destroy
- end;
-
- function TVector.Dot(v: TVector): Real;
- var
- x: Real;
- i: Word;
- begin
- if Count <> v.Count then raise EUnequalVectorLength.Create('Vectors of unequal length in dot product');
- x := 0;
- for i := 1 to Count do x := x + GetElement(i)*v.GetElement(i);
- Result := x;
- end;
-
- end.